{2}{4}{$C-,A+,D-}{[$C+,D+]}PROGRAM TANGLE(WEBFILE,CHANGEFILE,PASCALFILE,
POOL);LABEL 9999;CONST{8}BUFSIZE=100;MAXBYTES=65535;MAXTOKS=65535;
MAXNAMES=4000;MAXTEXTS=2000;HASHSIZE=353;LONGESTNAME=400;LINELENGTH=72;
OUTBUFSIZE=144;STACKSIZE=50;MAXIDLENGTH=12;UNAMBIGLENGT=7;
TYPE{9}ASCIICODE=0..127;{10}TEXTFILE=PACKED FILE OF CHAR;
{35}EIGHTBITS=0..255;SIXTEENBITS=0..65535;{37}NAMEPOINTER=0..MAXNAMES;
{40}TEXTPOINTER=0..MAXTEXTS;{74}OUTPUTSTATE=RECORD ENDFIELD:SIXTEENBITS;
BYTEFIELD:SIXTEENBITS;NAMEFIELD:NAMEPOINTER;REPLFIELD:TEXTPOINTER;END;
VAR{11}XORD:ARRAY[CHAR]OF ASCIICODE;XCHR:ARRAY[ASCIICODE]OF CHAR;
{18}TERMOUT:TEXTFILE;{21}WEBFILE:TEXTFILE;CHANGEFILE:TEXTFILE;
{23}PASCALFILE:TEXTFILE;POOL:TEXTFILE;
{25}BUFFER:ARRAY[0..BUFSIZE]OF ASCIICODE;
AUXBUFFER:ARRAY[0..BUFSIZE]OF CHAR;{27}PHASEONE:BOOLEAN;
{36}BYTEMEM:PACKED ARRAY[0..MAXBYTES]OF ASCIICODE;
TOKMEM:PACKED ARRAY[0..1,0..MAXTOKS]OF EIGHTBITS;
BYTESTART:ARRAY[0..MAXNAMES]OF SIXTEENBITS;
TOKSTART:ARRAY[0..MAXTEXTS]OF SIXTEENBITS;
LINK:ARRAY[0..MAXNAMES]OF SIXTEENBITS;
ILK:ARRAY[0..MAXNAMES]OF SIXTEENBITS;
EQUIV:ARRAY[0..MAXNAMES]OF SIXTEENBITS;
TEXTLINK:ARRAY[0..MAXTEXTS]OF SIXTEENBITS;{38}NAMEPTR:NAMEPOINTER;
STRINGPTR:NAMEPOINTER;BYTEPTR:0..MAXBYTES;{41}TEXTPTR:TEXTPOINTER;
TOKPTR:ARRAY[0..1]OF 0..MAXTOKS;Z:0..1;
MAXTOKPTR:ARRAY[0..1]OF 0..MAXTOKS;{46}IDFIRST:0..BUFSIZE;
IDLOC:0..BUFSIZE;DOUBLECHARS:0..BUFSIZE;
HASH,CHOPHASH:ARRAY[0..HASHSIZE]OF SIXTEENBITS;
CHOPPEDID:ARRAY[0..UNAMBIGLENGT]OF ASCIICODE;
{61}MODTEXT:ARRAY[0..LONGESTNAME]OF ASCIICODE;
{66}LASTUNNAMED:TEXTPOINTER;{75}CURSTATE:OUTPUTSTATE;
STACK:ARRAY[1..STACKSIZE]OF OUTPUTSTATE;STACKPTR:0..STACKSIZE;
{76}ZO:0..1;{78}BRACELEVEL:EIGHTBITS;{82}CURVAL:INTEGER;
{90}OUTBUF:ARRAY[0..OUTBUFSIZE]OF ASCIICODE;OUTPTR:0..OUTBUFSIZE;
BREAKPTR:0..OUTBUFSIZE;SEMIPTR:0..OUTBUFSIZE;{91}OUTSTATE:EIGHTBITS;
OUTVAL,OUTAPP:INTEGER;OUTSIGN:ASCIICODE;LASTSIGN:-1..+1;
{96}OUTCONTRIB:ARRAY[1..LINELENGTH]OF ASCIICODE;{118}LINE:INTEGER;
OTHERLINE:INTEGER;TEMPLINE:INTEGER;LIMIT:0..BUFSIZE;LOC:0..BUFSIZE;
INPUTHASENDE:BOOLEAN;CHANGING:BOOLEAN;
{119}CHANGEBUFFER:ARRAY[0..BUFSIZE]OF ASCIICODE;CHANGELIMIT:0..BUFSIZE;
{134}CURMODULE:NAMEPOINTER;{145}NEXTCONTROL:EIGHTBITS;
{152}CURREPLTEXT:TEXTPOINTER;{158}MODULECOUNT:0..12287;
{166}{TROUBLESHOOT:BOOLEAN;DDT:SIXTEENBITS;DD:SIXTEENBITS;
DEBUGCYCLE:INTEGER;DEBUGSKIPPED:INTEGER;TERMIN:TEXTFILE;
}{28}{PROCEDURE DEBUGHELP;FORWARD;}{29}PROCEDURE ERROR;
VAR J:0..OUTBUFSIZE;K,L:0..BUFSIZE;
BEGIN IF PHASEONE THEN{30}BEGIN IF CHANGING THEN WRITE(TERMOUT,
'. (change file ')ELSE WRITE(TERMOUT,'. (');
WRITELN(TERMOUT,'p.',1+(LINE DIV 65536):0,',l.',LINE MOD 65536:0,')');
IF LOC>=LIMIT THEN L:=LIMIT ELSE L:=LOC;
FOR K:=1 TO L DO IF BUFFER[K-1]=9 THEN WRITE(TERMOUT,' ')ELSE WRITE(
TERMOUT,XCHR[BUFFER[K-1]]);WRITELN(TERMOUT);
FOR K:=1 TO L DO WRITE(TERMOUT,' ');
FOR K:=L+1 TO LIMIT DO WRITE(TERMOUT,XCHR[BUFFER[K-1]]);
WRITE(TERMOUT,' ');
END ELSE{31}BEGIN WRITELN(TERMOUT,'. (l.',LINE:0,')');
FOR J:=1 TO OUTPTR DO WRITE(TERMOUT,XCHR[OUTBUF[J-1]]);
WRITE(TERMOUT,'... ');END;BREAK(TERMOUT);{DEBUGHELP;}END;
{32}PROCEDURE QUIT;BEGIN GOTO 9999;END;PROCEDURE INITIALIZE;
VAR{14}I:0..127;{47}H:0..HASHSIZE;BEGIN{12}XCHR[32]:=' ';XCHR[33]:='!';
XCHR[34]:='"';XCHR[35]:='#';XCHR[36]:='$';XCHR[37]:='%';XCHR[38]:='&';
XCHR[39]:='''';XCHR[40]:='(';XCHR[41]:=')';XCHR[42]:='*';XCHR[43]:='+';
XCHR[44]:=',';XCHR[45]:='-';XCHR[46]:='.';XCHR[47]:='/';XCHR[48]:='0';
XCHR[49]:='1';XCHR[50]:='2';XCHR[51]:='3';XCHR[52]:='4';XCHR[53]:='5';
XCHR[54]:='6';XCHR[55]:='7';XCHR[56]:='8';XCHR[57]:='9';XCHR[58]:=':';
XCHR[59]:=';';XCHR[60]:='<';XCHR[61]:='=';XCHR[62]:='>';XCHR[63]:='?';
XCHR[64]:='@';XCHR[65]:='A';XCHR[66]:='B';XCHR[67]:='C';XCHR[68]:='D';
XCHR[69]:='E';XCHR[70]:='F';XCHR[71]:='G';XCHR[72]:='H';XCHR[73]:='I';
XCHR[74]:='J';XCHR[75]:='K';XCHR[76]:='L';XCHR[77]:='M';XCHR[78]:='N';
XCHR[79]:='O';XCHR[80]:='P';XCHR[81]:='Q';XCHR[82]:='R';XCHR[83]:='S';
XCHR[84]:='T';XCHR[85]:='U';XCHR[86]:='V';XCHR[87]:='W';XCHR[88]:='X';
XCHR[89]:='Y';XCHR[90]:='Z';XCHR[91]:='[';XCHR[92]:='\';XCHR[93]:=']';
XCHR[94]:='↑';XCHR[95]:='_';XCHR[96]:='`';XCHR[97]:='a';XCHR[98]:='b';
XCHR[99]:='c';XCHR[100]:='d';XCHR[101]:='e';XCHR[102]:='f';
XCHR[103]:='g';XCHR[104]:='h';XCHR[105]:='i';XCHR[106]:='j';
XCHR[107]:='k';XCHR[108]:='l';XCHR[109]:='m';XCHR[110]:='n';
XCHR[111]:='o';XCHR[112]:='p';XCHR[113]:='q';XCHR[114]:='r';
XCHR[115]:='s';XCHR[116]:='t';XCHR[117]:='u';XCHR[118]:='v';
XCHR[119]:='w';XCHR[120]:='x';XCHR[121]:='y';XCHR[122]:='z';
XCHR[123]:='{';XCHR[124]:='|';XCHR[125]:='}';XCHR[126]:='~';
XCHR[0]:=' ';XCHR[127]:=' ';{15}FOR I:=1 TO 31 DO XCHR[I]:=CHR(I);
XCHR[24]:=CHR(95);XCHR[26]:=CHR(27);XCHR[27]:=CHR(126);
{16}FOR I:=0 TO 127 DO XORD[CHR(I)]:=32;
FOR I:=1 TO 126 DO XORD[XCHR[I]]:=I;{19}REWRITE(TERMOUT,'TTY:');
{24}REWRITE(PASCALFILE,'','/N:19');REWRITE(POOL,'','/N:19');
{39}NAMEPTR:=1;STRINGPTR:=128;BYTEPTR:=1;BYTESTART[0]:=1;
BYTESTART[1]:=1;{42}FOR Z:=0 TO 1 DO BEGIN TOKSTART[Z]:=0;TOKPTR[Z]:=0;
END;TOKSTART[2]:=0;TEXTPTR:=1;Z:=1 MOD 2;{44}ILK[0]:=0;EQUIV[0]:=0;
{48}FOR H:=0 TO HASHSIZE-1 DO BEGIN HASH[H]:=0;CHOPHASH[H]:=0;END;
{67}LASTUNNAMED:=0;TEXTLINK[0]:=0;{141}MODTEXT[0]:=32;
{167}{TROUBLESHOOT:=TRUE;DEBUGCYCLE:=1;DEBUGSKIPPED:=0;
TROUBLESHOOT:=FALSE;DEBUGCYCLE:=99999;RESET(TERMIN,'TTY:','/I');}END;
{22}PROCEDURE OPENINPUT;BEGIN RESET(WEBFILE,'','/E/N:19');
RESET(CHANGEFILE,'','/E/N:19');END;
{26}FUNCTION INPUTLN(VAR F:TEXTFILE):BOOLEAN;LABEL 20;VAR N:INTEGER;
K:0..BUFSIZE;BEGIN 20:IF EOF(F)THEN BEGIN LIMIT:=0;INPUTLN:=FALSE;
END ELSE BEGIN READ(F,AUXBUFFER:N);
IF(LINE=1)AND(N=29)AND(AUXBUFFER[0]='C')AND(AUXBUFFER[8]=CHR(22))THEN
BEGIN WHILE(F↑<>CHR(12))AND(NOT EOF(F))DO BEGIN READLN(F);
READ(F,AUXBUFFER:N);END;END;IF N<BUFSIZE THEN BEGIN LIMIT:=N;
IF N>0 THEN FOR K:=0 TO LIMIT-1 DO BUFFER[K]:=XORD[AUXBUFFER[K]]ELSE IF
F↑=CHR(12)THEN BEGIN LINE:=((LINE DIV 65536)+1)*65536+1;READLN(F);
GOTO 20;END;END ELSE BEGIN LIMIT:=BUFSIZE-1;
FOR K:=0 TO LIMIT-1 DO BUFFER[K]:=XORD[AUXBUFFER[K]];
BEGIN WRITELN(TERMOUT);WRITE(TERMOUT,'! Input line too long');END;ERROR;
WHILE NOT EOLN(F)DO READ(F,AUXBUFFER);END;READLN(F);INPUTLN:=TRUE;END;
END;{45}PROCEDURE PRINTID(P:NAMEPOINTER);VAR K:0..MAXBYTES;
BEGIN IF P>=NAMEPTR THEN WRITE(TERMOUT,'IMPOSSIBLE')ELSE FOR K:=
BYTESTART[P]TO BYTESTART[P+1]-1 DO WRITE(TERMOUT,XCHR[BYTEMEM[K]]);END;
{49}FUNCTION IDLOOKUP(T:EIGHTBITS):NAMEPOINTER;LABEL 31,32;
VAR C:EIGHTBITS;I:0..BUFSIZE;H:0..HASHSIZE;K:0..MAXBYTES;L:0..BUFSIZE;
P,Q:NAMEPOINTER;S:0..UNAMBIGLENGT;BEGIN L:=IDLOC-IDFIRST;
{50}H:=BUFFER[IDFIRST];I:=IDFIRST+1;
WHILE I<IDLOC DO BEGIN H:=(H+H+BUFFER[I])MOD HASHSIZE;I:=I+1;END;
{51}P:=HASH[H];
WHILE P<>0 DO BEGIN IF BYTESTART[P+1]-BYTESTART[P]=L THEN{52}BEGIN I:=
IDFIRST;K:=BYTESTART[P];
WHILE(I<IDLOC)AND(BUFFER[I]=BYTEMEM[K])DO BEGIN I:=I+1;K:=K+1;END;
IF I=IDLOC THEN GOTO 31;END;P:=LINK[P];END;P:=NAMEPTR;LINK[P]:=HASH[H];
HASH[H]:=P;31:;
IF(P=NAMEPTR)OR(T<>0)THEN{53}BEGIN IF((P<>NAMEPTR)AND(T<>0)AND(ILK[P]=0)
)OR((P=NAMEPTR)AND(T=0)AND(BUFFER[IDFIRST]<>34))THEN{54}BEGIN I:=IDFIRST
;S:=0;H:=0;
WHILE(I<IDLOC)AND(S<UNAMBIGLENGT)DO BEGIN IF BUFFER[I]<>95 THEN BEGIN IF
BUFFER[I]>=97 THEN CHOPPEDID[S]:=BUFFER[I]-32 ELSE CHOPPEDID[S]:=BUFFER[
I];H:=(H+H+CHOPPEDID[S])MOD HASHSIZE;S:=S+1;END;I:=I+1;END;
CHOPPEDID[S]:=0;END;
IF P<>NAMEPTR THEN{55}BEGIN IF ILK[P]=0 THEN BEGIN BEGIN WRITELN(TERMOUT
);WRITE(TERMOUT,'! This identifier has already appeared');ERROR;END;
{56}Q:=CHOPHASH[H];
IF Q=P THEN CHOPHASH[H]:=EQUIV[P]ELSE BEGIN WHILE EQUIV[Q]<>P DO Q:=
EQUIV[Q];EQUIV[Q]:=EQUIV[P];END;END ELSE BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! This identifier was defined before');ERROR;END;
ILK[P]:=T;
END ELSE{57}BEGIN IF(T=0)AND(BUFFER[IDFIRST]<>34)THEN{58}BEGIN Q:=
CHOPHASH[H];WHILE Q<>0 DO BEGIN{59}BEGIN K:=BYTESTART[Q];S:=0;
WHILE(K<BYTESTART[Q+1])AND(S<UNAMBIGLENGT)DO BEGIN C:=BYTEMEM[K];
IF C<>95 THEN BEGIN IF C>=97 THEN C:=C-32;
IF CHOPPEDID[S]<>C THEN GOTO 32;S:=S+1;END;K:=K+1;END;
IF(K=BYTESTART[Q+1])AND(CHOPPEDID[S]<>0)THEN GOTO 32;
BEGIN WRITELN(TERMOUT);WRITE(TERMOUT,'! Identifier conflict with ');END;
FOR K:=BYTESTART[Q]TO BYTESTART[Q+1]-1 DO WRITE(TERMOUT,XCHR[BYTEMEM[K]]
);ERROR;Q:=0;32:END;Q:=EQUIV[Q];END;EQUIV[P]:=CHOPHASH[H];
CHOPHASH[H]:=P;END;IF BYTEPTR+L>MAXBYTES THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Sorry, ','byte memory',' capacity exceeded');ERROR;
QUIT;END;IF NAMEPTR=MAXNAMES THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Sorry, ','name',' capacity exceeded');ERROR;QUIT;END;
I:=IDFIRST;K:=BYTEPTR;WHILE I<IDLOC DO BEGIN BYTEMEM[K]:=BUFFER[I];
K:=K+1;I:=I+1;END;BYTEPTR:=K;NAMEPTR:=NAMEPTR+1;BYTESTART[NAMEPTR]:=K;
IF BUFFER[IDFIRST]<>34 THEN ILK[P]:=T ELSE{60}BEGIN ILK[P]:=1;
IF L-DOUBLECHARS=2 THEN EQUIV[P]:=BUFFER[IDFIRST+1]+32768 ELSE BEGIN
EQUIV[P]:=STRINGPTR+32768;L:=L-DOUBLECHARS-1;
IF L>99 THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Preprocessed string is too long');ERROR;END;
STRINGPTR:=STRINGPTR+1;WRITE(POOL,XCHR[48+L DIV 10],XCHR[48+L MOD 10]);
I:=IDFIRST+1;WHILE I<IDLOC DO BEGIN WRITE(POOL,XCHR[BUFFER[I]]);
IF(BUFFER[I]=34)OR(BUFFER[I]=64)THEN I:=I+2 ELSE I:=I+1;END;
WRITELN(POOL);END;END;END;END;IDLOOKUP:=P;END;
{62}FUNCTION MODLOOKUP(L:SIXTEENBITS):NAMEPOINTER;LABEL 31;
VAR C:(LESS,EQUAL,GREATER,PREFIX,EXTENSION);J:0..LONGESTNAME;
K:0..MAXBYTES;P:NAMEPOINTER;Q:NAMEPOINTER;BEGIN C:=GREATER;Q:=0;
P:=ILK[0];WHILE P<>0 DO BEGIN{64}BEGIN K:=BYTESTART[P];C:=EQUAL;J:=1;
WHILE(K<BYTESTART[P+1])AND(J<=L)AND(MODTEXT[J]=BYTEMEM[K])DO BEGIN K:=K
+1;J:=J+1;END;
IF K=BYTESTART[P+1]THEN IF J>L THEN C:=EQUAL ELSE C:=EXTENSION ELSE IF J
>L THEN C:=PREFIX ELSE IF MODTEXT[J]<BYTEMEM[K]THEN C:=LESS ELSE C:=
GREATER;END;Q:=P;
IF C=LESS THEN P:=LINK[Q]ELSE IF C=GREATER THEN P:=ILK[Q]ELSE GOTO 31;
END;{63}IF BYTEPTR+L>MAXBYTES THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Sorry, ','byte memory',' capacity exceeded');ERROR;
QUIT;END;IF NAMEPTR=MAXNAMES THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Sorry, ','name',' capacity exceeded');ERROR;QUIT;END;
P:=NAMEPTR;IF C=LESS THEN LINK[Q]:=P ELSE ILK[Q]:=P;LINK[P]:=0;
ILK[P]:=0;C:=EQUAL;EQUIV[P]:=0;
FOR J:=1 TO L DO BYTEMEM[BYTEPTR+J-1]:=MODTEXT[J];BYTEPTR:=BYTEPTR+L;
NAMEPTR:=NAMEPTR+1;BYTESTART[NAMEPTR]:=BYTEPTR;;
31:IF C<>EQUAL THEN BEGIN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Incompatible module names');ERROR;END;P:=0;END;
MODLOOKUP:=P;END;{65}FUNCTION PREFIXLOOKUP(L:SIXTEENBITS):NAMEPOINTER;
VAR C:(LESS,EQUAL,GREATER,PREFIX,EXTENSION);COUNT:0..MAXNAMES;
J:0..LONGESTNAME;K:0..MAXBYTES;P:NAMEPOINTER;Q:NAMEPOINTER;
R:NAMEPOINTER;BEGIN Q:=0;P:=ILK[0];COUNT:=0;R:=0;
WHILE P<>0 DO BEGIN{64}BEGIN K:=BYTESTART[P];C:=EQUAL;J:=1;
WHILE(K<BYTESTART[P+1])AND(J<=L)AND(MODTEXT[J]=BYTEMEM[K])DO BEGIN K:=K
+1;J:=J+1;END;
IF K=BYTESTART[P+1]THEN IF J>L THEN C:=EQUAL ELSE C:=EXTENSION ELSE IF J
>L THEN C:=PREFIX ELSE IF MODTEXT[J]<BYTEMEM[K]THEN C:=LESS ELSE C:=
GREATER;END;
IF C=LESS THEN P:=LINK[P]ELSE IF C=GREATER THEN P:=ILK[P]ELSE BEGIN R:=P
;COUNT:=COUNT+1;Q:=ILK[P];P:=LINK[P];END;IF P=0 THEN BEGIN P:=Q;Q:=0;
END;END;IF COUNT<>1 THEN IF COUNT=0 THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Name does not match');ERROR;
END ELSE BEGIN WRITELN(TERMOUT);WRITE(TERMOUT,'! Ambiguous prefix');
ERROR;END;PREFIXLOOKUP:=R;END;{69}PROCEDURE STORETWOBYTE(X:SIXTEENBITS);
BEGIN IF TOKPTR[Z]+2>MAXTOKS THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Sorry, ','token',' capacity exceeded');ERROR;QUIT;END;
TOKMEM[Z,TOKPTR[Z]]:=X DIV 256;TOKMEM[Z,TOKPTR[Z]+1]:=X MOD 256;
TOKPTR[Z]:=TOKPTR[Z]+2;END;{70}{PROCEDURE PRINTREPL(P:TEXTPOINTER);
VAR K:0..MAXTOKS;A:SIXTEENBITS;ZP:0..1;
BEGIN IF P>=TEXTPTR THEN WRITE(TERMOUT,'BAD')ELSE BEGIN K:=TOKSTART[P];
ZP:=P MOD 2;WHILE K<TOKSTART[P+2]DO BEGIN A:=TOKMEM[ZP,K];
IF A>=128 THEN[71]BEGIN K:=K+1;
IF A<168 THEN BEGIN A:=(A-128)*256+TOKMEM[ZP,K];PRINTID(A);
IF BYTEMEM[BYTESTART[A]]=34 THEN WRITE(TERMOUT,'"')ELSE WRITE(TERMOUT,
' ');END ELSE IF A<208 THEN BEGIN WRITE(TERMOUT,'@<');
PRINTID((A-168)*256+TOKMEM[ZP,K]);WRITE(TERMOUT,'@>');
END ELSE BEGIN A:=(A-208)*256+TOKMEM[ZP,K];
WRITE(TERMOUT,'@',XCHR[123],A:0,'@',XCHR[125]);END;
END ELSE[72]CASE A OF 9:WRITE(TERMOUT,'@',XCHR[123]);
10:WRITE(TERMOUT,'@',XCHR[125]);12:WRITE(TERMOUT,'@''');
13:WRITE(TERMOUT,'#');64:WRITE(TERMOUT,'@@');
OTHERS:WRITE(TERMOUT,XCHR[A])END;K:=K+1;END;END;END;
}{80}PROCEDURE PUSHLEVEL(P:NAMEPOINTER);
BEGIN IF STACKPTR=STACKSIZE THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Sorry, ','stack',' capacity exceeded');ERROR;QUIT;
END ELSE BEGIN STACK[STACKPTR]:=CURSTATE;STACKPTR:=STACKPTR+1;
CURSTATE.NAMEFIELD:=P;CURSTATE.REPLFIELD:=EQUIV[P];
ZO:=CURSTATE.REPLFIELD MOD 2;
CURSTATE.BYTEFIELD:=TOKSTART[CURSTATE.REPLFIELD];
CURSTATE.ENDFIELD:=TOKSTART[CURSTATE.REPLFIELD+2];END;END;
{81}PROCEDURE POPLEVEL;LABEL 10;
BEGIN IF TEXTLINK[CURSTATE.REPLFIELD]=0 THEN BEGIN IF ILK[CURSTATE.
NAMEFIELD]=3 THEN{87}BEGIN NAMEPTR:=NAMEPTR-1;TEXTPTR:=TEXTPTR-1;
Z:=TEXTPTR MOD 2;IF TOKPTR[Z]>MAXTOKPTR[Z]THEN MAXTOKPTR[Z]:=TOKPTR[Z];
TOKPTR[Z]:=TOKSTART[TEXTPTR];{BYTEPTR:=BYTEPTR-1;}END;
END ELSE IF TEXTLINK[CURSTATE.REPLFIELD]<MAXTEXTS THEN BEGIN CURSTATE.
REPLFIELD:=TEXTLINK[CURSTATE.REPLFIELD];ZO:=CURSTATE.REPLFIELD MOD 2;
CURSTATE.BYTEFIELD:=TOKSTART[CURSTATE.REPLFIELD];
CURSTATE.ENDFIELD:=TOKSTART[CURSTATE.REPLFIELD+2];GOTO 10;END;
STACKPTR:=STACKPTR-1;IF STACKPTR>0 THEN BEGIN CURSTATE:=STACK[STACKPTR];
ZO:=CURSTATE.REPLFIELD MOD 2;END;10:END;
{83}FUNCTION GETOUTPUT:SIXTEENBITS;LABEL 20,30;VAR A:SIXTEENBITS;
B:EIGHTBITS;BAL:SIXTEENBITS;
BEGIN 20:IF STACKPTR=0 THEN A:=0 ELSE BEGIN IF CURSTATE.BYTEFIELD=
CURSTATE.ENDFIELD THEN BEGIN POPLEVEL;GOTO 20;END;
A:=TOKMEM[ZO,CURSTATE.BYTEFIELD];
CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;
IF A<128 THEN BEGIN IF A=13 THEN{88}BEGIN PUSHLEVEL(NAMEPTR-1);GOTO 20;
END;END ELSE BEGIN A:=(A-128)*256+TOKMEM[ZO,CURSTATE.BYTEFIELD];
CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;
IF A<10240 THEN{85}BEGIN CASE ILK[A]OF 0:BEGIN CURVAL:=A;A:=130;END;
1:BEGIN CURVAL:=EQUIV[A]-32768;A:=128;END;2:BEGIN PUSHLEVEL(A);GOTO 20;
END;
3:BEGIN{86}WHILE(CURSTATE.BYTEFIELD=CURSTATE.ENDFIELD)AND(STACKPTR>0)DO
POPLEVEL;
IF(STACKPTR=0)OR(TOKMEM[ZO,CURSTATE.BYTEFIELD]<>40)THEN BEGIN BEGIN
WRITELN(TERMOUT);WRITE(TERMOUT,'! No parameter given for ');END;
PRINTID(A);ERROR;GOTO 20;END;{89}BAL:=1;
CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;
WHILE TRUE DO BEGIN B:=TOKMEM[ZO,CURSTATE.BYTEFIELD];
CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;
IF B=13 THEN STORETWOBYTE(NAMEPTR+32767)ELSE BEGIN IF B>=128 THEN BEGIN
BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Sorry, ','token',' capacity exceeded');ERROR;QUIT;END;
TOKMEM[Z,TOKPTR[Z]]:=B;TOKPTR[Z]:=TOKPTR[Z]+1;END;
B:=TOKMEM[ZO,CURSTATE.BYTEFIELD];
CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;
END ELSE CASE B OF 40:BAL:=BAL+1;41:BEGIN BAL:=BAL-1;
IF BAL=0 THEN GOTO 30;END;
39:REPEAT BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Sorry, ','token',' capacity exceeded');ERROR;QUIT;END;
TOKMEM[Z,TOKPTR[Z]]:=B;TOKPTR[Z]:=TOKPTR[Z]+1;END;
B:=TOKMEM[ZO,CURSTATE.BYTEFIELD];
CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;UNTIL B=39;OTHERS:END;
BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Sorry, ','token',' capacity exceeded');ERROR;QUIT;END;
TOKMEM[Z,TOKPTR[Z]]:=B;TOKPTR[Z]:=TOKPTR[Z]+1;END;END;END;30:;
EQUIV[NAMEPTR]:=TEXTPTR;ILK[NAMEPTR]:=2;
{IF BYTEPTR=MAXBYTES THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Sorry, ','byte memory',' capacity exceeded');ERROR;
QUIT;END;BYTEMEM[BYTEPTR]:=35;BYTEPTR:=BYTEPTR+1;
}IF NAMEPTR=MAXNAMES THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Sorry, ','name',' capacity exceeded');ERROR;QUIT;END;
NAMEPTR:=NAMEPTR+1;BYTESTART[NAMEPTR]:=BYTEPTR;
IF TEXTPTR>MAXTEXTS-2 THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Sorry, ','text',' capacity exceeded');ERROR;QUIT;END;
TEXTLINK[TEXTPTR]:=0;TOKSTART[TEXTPTR+2]:=TOKPTR[Z];TEXTPTR:=TEXTPTR+1;
Z:=TEXTPTR MOD 2;PUSHLEVEL(A);GOTO 20;END;OTHERS:BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! This can''t happen (','output',')');ERROR;QUIT;
END END END ELSE IF A<20480 THEN{84}BEGIN A:=A-10240;
IF EQUIV[A]<>0 THEN PUSHLEVEL(A)ELSE IF A<>0 THEN BEGIN BEGIN WRITELN(
TERMOUT);WRITE(TERMOUT,'! Not present: <');END;PRINTID(A);
WRITE(TERMOUT,'>');ERROR;END;GOTO 20;END ELSE BEGIN CURVAL:=A-20480;
A:=129;END;END;END;{IF TROUBLESHOOT THEN DEBUGHELP;}GETOUTPUT:=A;END;
{93}PROCEDURE FLUSHBUFFER;VAR K:0..OUTBUFSIZE;B:0..OUTBUFSIZE;
BEGIN B:=BREAKPTR;
IF(SEMIPTR<>0)AND(OUTPTR-SEMIPTR<=LINELENGTH)THEN BREAKPTR:=SEMIPTR;
FOR K:=1 TO BREAKPTR DO WRITE(PASCALFILE,XCHR[OUTBUF[K-1]]);
WRITELN(PASCALFILE);LINE:=LINE+1;
IF LINE MOD 100=0 THEN BEGIN WRITE(TERMOUT,'.');
IF LINE MOD 500=0 THEN WRITE(TERMOUT,LINE:0);BREAK(TERMOUT);END;
IF BREAKPTR<OUTPTR THEN BEGIN IF OUTBUF[BREAKPTR]=32 THEN BEGIN BREAKPTR
:=BREAKPTR+1;IF BREAKPTR>B THEN B:=BREAKPTR;END;
FOR K:=BREAKPTR TO OUTPTR-1 DO OUTBUF[K-BREAKPTR]:=OUTBUF[K];END;
OUTPTR:=OUTPTR-BREAKPTR;BREAKPTR:=B-BREAKPTR;SEMIPTR:=0;
IF OUTPTR>LINELENGTH THEN BEGIN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Long line must be truncated');ERROR;END;
OUTPTR:=LINELENGTH;END;END;{95}PROCEDURE APPVAL(V:INTEGER);
VAR K:0..OUTBUFSIZE;BEGIN K:=OUTBUFSIZE;REPEAT OUTBUF[K]:=V MOD 10;
V:=V DIV 10;K:=K-1;UNTIL V=0;REPEAT K:=K+1;
BEGIN OUTBUF[OUTPTR]:=OUTBUF[K]+48;OUTPTR:=OUTPTR+1;END;
UNTIL K=OUTBUFSIZE;END;{97}PROCEDURE SENDOUT(T:EIGHTBITS;V:SIXTEENBITS);
LABEL 20;VAR K:0..LINELENGTH;
BEGIN{98}20:CASE OUTSTATE OF 1:IF T<>3 THEN BEGIN BREAKPTR:=OUTPTR;
IF T=2 THEN BEGIN OUTBUF[OUTPTR]:=32;OUTPTR:=OUTPTR+1;END;END;
2:BEGIN BEGIN OUTBUF[OUTPTR]:=44-OUTAPP;OUTPTR:=OUTPTR+1;END;
IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;BREAKPTR:=OUTPTR;END;
3,4:BEGIN{99}IF(OUTVAL<0)OR((OUTVAL=0)AND(LASTSIGN<0))THEN BEGIN OUTBUF[
OUTPTR]:=45;OUTPTR:=OUTPTR+1;
END ELSE IF OUTSIGN>0 THEN BEGIN OUTBUF[OUTPTR]:=OUTSIGN;
OUTPTR:=OUTPTR+1;END;APPVAL(ABS(OUTVAL));
IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;;OUTSTATE:=OUTSTATE-2;GOTO 20;END;
5:{100}BEGIN IF(T=3)OR({101}((T=2)AND(V=3)AND(((OUTCONTRIB[1]=68)AND(
OUTCONTRIB[2]=73)AND(OUTCONTRIB[3]=86))OR((OUTCONTRIB[1]=77)AND(
OUTCONTRIB[2]=79)AND(OUTCONTRIB[3]=68))))OR((T=0)AND((V=42)OR(V=47))))
THEN BEGIN{99}IF(OUTVAL<0)OR((OUTVAL=0)AND(LASTSIGN<0))THEN BEGIN OUTBUF
[OUTPTR]:=45;OUTPTR:=OUTPTR+1;
END ELSE IF OUTSIGN>0 THEN BEGIN OUTBUF[OUTPTR]:=OUTSIGN;
OUTPTR:=OUTPTR+1;END;APPVAL(ABS(OUTVAL));
IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;;OUTSIGN:=43;OUTVAL:=OUTAPP;
END ELSE OUTVAL:=OUTVAL+OUTAPP;OUTSTATE:=3;GOTO 20;END;
0:IF T<>3 THEN BREAKPTR:=OUTPTR;OTHERS:END;
IF T<>0 THEN FOR K:=1 TO V DO BEGIN OUTBUF[OUTPTR]:=OUTCONTRIB[K];
OUTPTR:=OUTPTR+1;END ELSE BEGIN OUTBUF[OUTPTR]:=V;OUTPTR:=OUTPTR+1;END;
IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;
IF(T=0)AND(V=59)THEN BEGIN SEMIPTR:=OUTPTR;BREAKPTR:=OUTPTR;END;
IF T>=2 THEN OUTSTATE:=1 ELSE OUTSTATE:=0 END;
{102}PROCEDURE SENDSIGN(V:INTEGER);
BEGIN CASE OUTSTATE OF 2,4:OUTAPP:=OUTAPP*V;3:BEGIN OUTAPP:=V;
OUTSTATE:=4;END;5:BEGIN OUTVAL:=OUTVAL+OUTAPP;OUTAPP:=V;OUTSTATE:=4;END;
OTHERS:BEGIN BREAKPTR:=OUTPTR;OUTAPP:=V;OUTSTATE:=2;END END;
LASTSIGN:=OUTAPP;END;{103}PROCEDURE SENDVAL(V:INTEGER);LABEL 666,10;
BEGIN CASE OUTSTATE OF 1:BEGIN{106}IF(OUTPTR=BREAKPTR+3)OR((OUTPTR=
BREAKPTR+4)AND(OUTBUF[BREAKPTR]=32))THEN IF((OUTBUF[OUTPTR-3]=68)AND(
OUTBUF[OUTPTR-2]=73)AND(OUTBUF[OUTPTR-1]=86))OR((OUTBUF[OUTPTR-3]=77)AND
(OUTBUF[OUTPTR-2]=79)AND(OUTBUF[OUTPTR-1]=68))THEN GOTO 666;OUTSIGN:=32;
OUTSTATE:=3;OUTVAL:=V;BREAKPTR:=OUTPTR;LASTSIGN:=+1;END;
0:BEGIN{105}IF(OUTPTR=BREAKPTR+1)AND((OUTBUF[BREAKPTR]=42)OR(OUTBUF[
BREAKPTR]=47))THEN GOTO 666;OUTSIGN:=0;OUTSTATE:=3;OUTVAL:=V;
BREAKPTR:=OUTPTR;LASTSIGN:=+1;END;{104}2:BEGIN OUTSIGN:=43;OUTSTATE:=3;
OUTVAL:=OUTAPP*V;END;3:BEGIN OUTSTATE:=5;OUTAPP:=V;
BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Two numbers occurred without a sign between them');
ERROR;END;END;4:BEGIN OUTSTATE:=5;OUTAPP:=OUTAPP*V;END;
5:BEGIN OUTVAL:=OUTVAL+OUTAPP;OUTAPP:=V;BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Two numbers occurred without a sign between them');
ERROR;END;END;OTHERS:GOTO 666 END;GOTO 10;
666:{107}IF V>=0 THEN BEGIN IF OUTSTATE=1 THEN BEGIN BREAKPTR:=OUTPTR;
BEGIN OUTBUF[OUTPTR]:=32;OUTPTR:=OUTPTR+1;END;END;APPVAL(V);
IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;OUTSTATE:=1;
END ELSE BEGIN BEGIN OUTBUF[OUTPTR]:=40;OUTPTR:=OUTPTR+1;END;
BEGIN OUTBUF[OUTPTR]:=45;OUTPTR:=OUTPTR+1;END;APPVAL(-V);
BEGIN OUTBUF[OUTPTR]:=41;OUTPTR:=OUTPTR+1;END;
IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;OUTSTATE:=0;END;10:END;
{109}PROCEDURE SENDTHEOUTPU;LABEL 2,21,22;VAR CURCHAR:EIGHTBITS;
K:0..LINELENGTH;J:0..MAXBYTES;N:INTEGER;
BEGIN WHILE STACKPTR>0 DO BEGIN CURCHAR:=GETOUTPUT;
21:CASE CURCHAR OF 0:;
{112}65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,
87,88,89,90:BEGIN OUTCONTRIB[1]:=CURCHAR;SENDOUT(2,1);END;
97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115
,116,117,118,119,120,121,122:BEGIN OUTCONTRIB[1]:=CURCHAR-32;
SENDOUT(2,1);END;130:BEGIN K:=0;J:=BYTESTART[CURVAL];
WHILE(K<MAXIDLENGTH)AND(J<BYTESTART[CURVAL+1])DO BEGIN K:=K+1;
OUTCONTRIB[K]:=BYTEMEM[J];J:=J+1;
IF OUTCONTRIB[K]>=97 THEN OUTCONTRIB[K]:=OUTCONTRIB[K]-32 ELSE IF
OUTCONTRIB[K]=95 THEN K:=K-1;END;SENDOUT(2,K);END;
{114}48,49,50,51,52,53,54,55,56,57:BEGIN N:=0;
REPEAT IF N>=214748364 THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Constant too big');ERROR;END ELSE N:=10*N+CURCHAR-48;
CURCHAR:=GETOUTPUT;UNTIL(CURCHAR>57)OR(CURCHAR<48);SENDVAL(N);K:=0;
IF CURCHAR=101 THEN CURCHAR:=69;IF CURCHAR=69 THEN GOTO 2 ELSE GOTO 21;
END;12:BEGIN N:=0;CURCHAR:=48;
REPEAT IF N>=268435456 THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Constant too big');ERROR;END ELSE N:=8*N+CURCHAR-48;
CURCHAR:=GETOUTPUT;UNTIL(CURCHAR>55)OR(CURCHAR<48);SENDVAL(N);GOTO 21;
END;128:SENDVAL(CURVAL);46:BEGIN K:=1;OUTCONTRIB[1]:=46;
CURCHAR:=GETOUTPUT;IF CURCHAR=46 THEN BEGIN OUTCONTRIB[2]:=46;
SENDOUT(1,2);
END ELSE IF(CURCHAR>=48)AND(CURCHAR<=57)THEN GOTO 2 ELSE BEGIN SENDOUT(0
,46);GOTO 21;END;END;43,45:SENDSIGN(44-CURCHAR);
{110}4:BEGIN OUTCONTRIB[1]:=65;OUTCONTRIB[2]:=78;OUTCONTRIB[3]:=68;
SENDOUT(2,3);END;5:BEGIN OUTCONTRIB[1]:=78;OUTCONTRIB[2]:=79;
OUTCONTRIB[3]:=84;SENDOUT(2,3);END;6:BEGIN OUTCONTRIB[1]:=73;
OUTCONTRIB[2]:=78;SENDOUT(2,2);END;31:BEGIN OUTCONTRIB[1]:=79;
OUTCONTRIB[2]:=82;SENDOUT(2,2);END;24:BEGIN OUTCONTRIB[1]:=58;
OUTCONTRIB[2]:=61;SENDOUT(1,2);END;26:BEGIN OUTCONTRIB[1]:=60;
OUTCONTRIB[2]:=62;SENDOUT(1,2);END;28:BEGIN OUTCONTRIB[1]:=60;
OUTCONTRIB[2]:=61;SENDOUT(1,2);END;29:BEGIN OUTCONTRIB[1]:=62;
OUTCONTRIB[2]:=61;SENDOUT(1,2);END;30:BEGIN OUTCONTRIB[1]:=61;
OUTCONTRIB[2]:=61;SENDOUT(1,2);END;32:BEGIN OUTCONTRIB[1]:=46;
OUTCONTRIB[2]:=46;SENDOUT(1,2);END;39:{113}BEGIN K:=1;OUTCONTRIB[1]:=39;
REPEAT IF K<LINELENGTH THEN K:=K+1;OUTCONTRIB[K]:=GETOUTPUT;
UNTIL(OUTCONTRIB[K]=39)OR(STACKPTR=0);
IF K=LINELENGTH THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! String too long');ERROR;END;SENDOUT(1,K);
CURCHAR:=GETOUTPUT;IF CURCHAR=39 THEN OUTSTATE:=6;GOTO 21;END;
{111}33,34,35,36,37,38,40,41,42,44,47,58,59,60,61,62,63,64,91,92,93,94,
95,96,123,124,125:SENDOUT(0,CURCHAR);
{116}9:BEGIN IF BRACELEVEL=0 THEN SENDOUT(0,123)ELSE SENDOUT(0,91);
BRACELEVEL:=BRACELEVEL+1;END;
10:IF BRACELEVEL>0 THEN BEGIN BRACELEVEL:=BRACELEVEL-1;
IF BRACELEVEL=0 THEN SENDOUT(0,125)ELSE SENDOUT(0,93);
END ELSE BEGIN WRITELN(TERMOUT);WRITE(TERMOUT,'! Extra @}');ERROR;END;
129:IF BRACELEVEL=0 THEN BEGIN SENDOUT(0,123);SENDVAL(CURVAL);
SENDOUT(0,125);END ELSE BEGIN SENDOUT(0,91);SENDVAL(CURVAL);
SENDOUT(0,93);END;127:BEGIN SENDOUT(3,0);OUTSTATE:=6;END;
OTHERS:BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Can''t output ascii code ',CURCHAR:0);ERROR;END END;
GOTO 22;2:{115}REPEAT IF K<LINELENGTH THEN K:=K+1;
OUTCONTRIB[K]:=CURCHAR;CURCHAR:=GETOUTPUT;
IF(OUTCONTRIB[K]=69)AND((CURCHAR=43)OR(CURCHAR=45))THEN BEGIN IF K<
LINELENGTH THEN K:=K+1;OUTCONTRIB[K]:=CURCHAR;CURCHAR:=GETOUTPUT;
END ELSE IF CURCHAR=101 THEN CURCHAR:=69;
UNTIL(CURCHAR<>69)AND((CURCHAR<48)OR(CURCHAR>57));
IF K=LINELENGTH THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Fraction too long');ERROR;END;SENDOUT(3,K);GOTO 21;
22:END;END;{120}PROCEDURE PRIMETHECHAN;LABEL 20;VAR K:0..BUFSIZE;
BEGIN 20:IF INPUTLN(CHANGEFILE)THEN BEGIN IF LIMIT=0 THEN GOTO 20;
FOR K:=0 TO LIMIT DO CHANGEBUFFER[K]:=BUFFER[K];CHANGELIMIT:=LIMIT;
END ELSE BEGIN CHANGEBUFFER[0]:=0;CHANGELIMIT:=0;END;END;
{121}PROCEDURE CHECKCHANGE;LABEL 10;VAR K:0..BUFSIZE;
BEGIN FOR K:=1 TO LIMIT-1 DO IF BUFFER[K]<>CHANGEBUFFER[K]THEN GOTO 10;
CHANGING:=TRUE;TEMPLINE:=OTHERLINE;OTHERLINE:=LINE;LINE:=TEMPLINE;
10:END;{123}PROCEDURE GETLINE;LABEL 10,30,31;BEGIN LINE:=LINE+1;
IF CHANGING THEN{125}BEGIN IF LIMIT>1 THEN IF(BUFFER[LIMIT-2]=64)AND((
BUFFER[LIMIT-1]=122)OR(BUFFER[LIMIT-1]=90))THEN{126}BEGIN CHANGING:=
FALSE;PRIMETHECHAN;TEMPLINE:=OTHERLINE;OTHERLINE:=LINE;LINE:=TEMPLINE;
{127}WHILE TRUE DO BEGIN LOC:=0;LINE:=LINE+1;
IF INPUTLN(WEBFILE)THEN{128}BEGIN BUFFER[LIMIT+1]:=64;
WHILE TRUE DO BEGIN IF BUFFER[LOC]=64 THEN IF LOC<LIMIT THEN BEGIN LOC:=
LOC+2;
IF(BUFFER[LOC-1]=32)OR(BUFFER[LOC-1]=9)OR(BUFFER[LOC-1]=42)THEN BEGIN
LOC:=LOC-2;GOTO 31;
END ELSE IF(BUFFER[LOC-1]=122)OR(BUFFER[LOC-1]=90)THEN GOTO 31;
END ELSE GOTO 30 ELSE LOC:=LOC+1;END;
30:END ELSE BEGIN INPUTHASENDE:=TRUE;GOTO 31;END;END;31:;
BUFFER[LIMIT]:=32;
IF(BUFFER[0]=CHANGEBUFFER[0])AND(LIMIT=CHANGELIMIT)THEN CHECKCHANGE;
GOTO 10;END;IF NOT INPUTLN(CHANGEFILE)THEN BEGIN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Change file ended without @z');ERROR;END;BUFFER[0]:=64;
BUFFER[1]:=122;LIMIT:=2;END;
END ELSE{124}BEGIN IF NOT INPUTLN(WEBFILE)THEN INPUTHASENDE:=TRUE ELSE
IF(BUFFER[0]=CHANGEBUFFER[0])AND(LIMIT=CHANGELIMIT)THEN CHECKCHANGE;END;
LOC:=0;BUFFER[LIMIT]:=32;10:END;
{130}FUNCTION CONTROLCODE(C:ASCIICODE):EIGHTBITS;
BEGIN CASE C OF 64:CONTROLCODE:=64;39:CONTROLCODE:=12;
32,9:CONTROLCODE:=137;42:BEGIN WRITE(TERMOUT,'*',MODULECOUNT+1:0);
BREAK(TERMOUT);CONTROLCODE:=137;END;68,100:CONTROLCODE:=133;
70,102:CONTROLCODE:=132;123:CONTROLCODE:=9;125:CONTROLCODE:=10;
80,112:CONTROLCODE:=134;84,116,94,46,58:CONTROLCODE:=131;
90,122:CONTROLCODE:=136;38:CONTROLCODE:=127;60:CONTROLCODE:=135;
OTHERS:CONTROLCODE:=0 END;END;{131}FUNCTION SKIPAHEAD:EIGHTBITS;
LABEL 30;VAR C:EIGHTBITS;
BEGIN WHILE TRUE DO BEGIN IF LOC>LIMIT THEN BEGIN GETLINE;
IF INPUTHASENDE THEN BEGIN C:=136;GOTO 30;END;END;BUFFER[LIMIT+1]:=64;
WHILE BUFFER[LOC]<>64 DO LOC:=LOC+1;IF LOC<=LIMIT THEN BEGIN LOC:=LOC+2;
C:=CONTROLCODE(BUFFER[LOC-1]);IF(C<>0)OR(BUFFER[LOC-1]=62)THEN GOTO 30;
END;END;30:SKIPAHEAD:=C;END;{132}PROCEDURE SKIPCOMMENT;LABEL 10;
VAR BAL:EIGHTBITS;C:ASCIICODE;BEGIN BAL:=0;
WHILE TRUE DO BEGIN IF LOC>LIMIT THEN BEGIN GETLINE;
IF INPUTHASENDE THEN BEGIN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Input ended in mid-comment');ERROR;END;GOTO 10;END;END;
C:=BUFFER[LOC];LOC:=LOC+1;{133}IF C=64 THEN BEGIN C:=BUFFER[LOC];
IF(C<>32)AND(C<>9)AND(C<>42)AND(C<>122)AND(C<>90)THEN LOC:=LOC+1 ELSE
BEGIN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Module ended in mid-comment');ERROR;END;LOC:=LOC-1;
GOTO 10;
END END ELSE IF(C=92)AND(BUFFER[LOC]<>64)THEN LOC:=LOC+1 ELSE IF C=123
THEN BAL:=BAL+1 ELSE IF C=125 THEN BEGIN IF BAL=0 THEN GOTO 10;
BAL:=BAL-1;END;END;10:END;{135}FUNCTION GETNEXT:EIGHTBITS;
LABEL 20,30,31;VAR C:EIGHTBITS;D:EIGHTBITS;J,K:0..LONGESTNAME;
BEGIN 20:IF LOC>LIMIT THEN BEGIN GETLINE;
IF INPUTHASENDE THEN BEGIN C:=136;GOTO 31;END;END;C:=BUFFER[LOC];
LOC:=LOC+1;
CASE C OF 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85
,86,87,88,89,90,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111
,112,113,114,115,116,117,118,119,120,121,122:{137}BEGIN IF((C=101)OR(C=
69))AND(LOC>1)THEN IF(BUFFER[LOC-2]<=57)AND(BUFFER[LOC-2]>=48)THEN C:=0;
IF C<>0 THEN BEGIN LOC:=LOC-1;IDFIRST:=LOC;REPEAT LOC:=LOC+1;
D:=BUFFER[LOC];
UNTIL((D<48)OR((D>57)AND(D<65))OR((D>90)AND(D<97))OR(D>122))AND(D<>95);
IF LOC>IDFIRST+1 THEN BEGIN C:=130;IDLOC:=LOC;END;END ELSE C:=69;END;
34:{138}BEGIN DOUBLECHARS:=0;IDFIRST:=LOC-1;REPEAT D:=BUFFER[LOC];
LOC:=LOC+1;IF(D=34)OR(D=64)THEN IF BUFFER[LOC]=D THEN BEGIN LOC:=LOC+1;
D:=0;DOUBLECHARS:=DOUBLECHARS+1;
END ELSE BEGIN IF D=64 THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Double @ sign missing');ERROR;
END END ELSE IF LOC>LIMIT THEN BEGIN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! String constant didn''t end');ERROR;END;D:=34;END;
UNTIL D=34;IDLOC:=LOC-1;C:=130;END;
64:{139}BEGIN C:=CONTROLCODE(BUFFER[LOC]);LOC:=LOC+1;
IF C=0 THEN GOTO 20 ELSE IF C=135 THEN{140}BEGIN{142}K:=0;
WHILE TRUE DO BEGIN IF LOC>LIMIT THEN BEGIN GETLINE;
IF INPUTHASENDE THEN BEGIN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Input ended in module name');ERROR;END;GOTO 30;END;END;
D:=BUFFER[LOC];{143}IF D=64 THEN BEGIN D:=BUFFER[LOC+1];
IF D=62 THEN BEGIN LOC:=LOC+2;GOTO 30;END;
IF(D=32)OR(D=9)OR(D=42)THEN BEGIN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Module name didn''t end');ERROR;END;GOTO 30;END;K:=K+1;
MODTEXT[K]:=64;LOC:=LOC+1;END;LOC:=LOC+1;IF K<LONGESTNAME-1 THEN K:=K+1;
IF(D=32)OR(D=9)THEN BEGIN D:=32;IF MODTEXT[K-1]=32 THEN K:=K-1;END;
MODTEXT[K]:=D;END;
30:{144}IF K>=LONGESTNAME-2 THEN BEGIN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Module name too long: ');END;
FOR J:=1 TO 25 DO WRITE(TERMOUT,XCHR[MODTEXT[J]]);WRITE(TERMOUT,'...');
END;IF(MODTEXT[K]=32)AND(K>0)THEN K:=K-1;;
IF K>3 THEN BEGIN IF(MODTEXT[K]=46)AND(MODTEXT[K-1]=46)AND(MODTEXT[K-2]=
46)THEN CURMODULE:=PREFIXLOOKUP(K-3)ELSE CURMODULE:=MODLOOKUP(K);
END ELSE CURMODULE:=MODLOOKUP(K);
END ELSE IF C=131 THEN BEGIN REPEAT C:=SKIPAHEAD;UNTIL C<>64;
IF BUFFER[LOC-1]<>62 THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Improper @ within control text');ERROR;END;GOTO 20;END;
END;{136}46:IF BUFFER[LOC]=46 THEN BEGIN C:=32;LOC:=LOC+1;
END ELSE IF BUFFER[LOC]=41 THEN BEGIN C:=93;LOC:=LOC+1;END;
58:IF BUFFER[LOC]=61 THEN BEGIN C:=24;LOC:=LOC+1;END;
61:IF BUFFER[LOC]=61 THEN BEGIN C:=30;LOC:=LOC+1;END;
62:IF BUFFER[LOC]=61 THEN BEGIN C:=29;LOC:=LOC+1;END;
60:IF BUFFER[LOC]=61 THEN BEGIN C:=28;LOC:=LOC+1;
END ELSE IF BUFFER[LOC]=62 THEN BEGIN C:=26;LOC:=LOC+1;END;
40:IF BUFFER[LOC]=42 THEN BEGIN C:=9;LOC:=LOC+1;
END ELSE IF BUFFER[LOC]=46 THEN BEGIN C:=91;LOC:=LOC+1;END;
42:IF BUFFER[LOC]=41 THEN BEGIN C:=10;LOC:=LOC+1;END;32,9:GOTO 20;
123:BEGIN SKIPCOMMENT;GOTO 20;END;OTHERS:END;
31:{IF TROUBLESHOOT THEN DEBUGHELP;}GETNEXT:=C;END;
{146}PROCEDURE SCANNUMERIC(P:NAMEPOINTER);LABEL 21,30;
VAR ACCUMULATOR:INTEGER;NEXTSIGN:-1..+1;Q:NAMEPOINTER;VAL:INTEGER;
PROCEDURE ADDIN(V:INTEGER);BEGIN ACCUMULATOR:=ACCUMULATOR+NEXTSIGN*V;
NEXTSIGN:=+1;END;BEGIN{147}ACCUMULATOR:=0;NEXTSIGN:=+1;
WHILE TRUE DO BEGIN NEXTCONTROL:=GETNEXT;
21:CASE NEXTCONTROL OF 48,49,50,51,52,53,54,55,56,57:BEGIN{149}VAL:=0;
REPEAT VAL:=10*VAL+NEXTCONTROL-48;NEXTCONTROL:=GETNEXT;
UNTIL(NEXTCONTROL>57)OR(NEXTCONTROL<48);;ADDIN(VAL);GOTO 21;END;
12:BEGIN{150}VAL:=0;NEXTCONTROL:=48;REPEAT VAL:=8*VAL+NEXTCONTROL-48;
NEXTCONTROL:=GETNEXT;UNTIL(NEXTCONTROL>55)OR(NEXTCONTROL<48);;
ADDIN(VAL);GOTO 21;END;130:BEGIN Q:=IDLOOKUP(0);
IF ILK[Q]<>1 THEN BEGIN NEXTCONTROL:=42;GOTO 21;END;
ADDIN(EQUIV[Q]-32768);END;43:;45:NEXTSIGN:=-NEXTSIGN;
132,133,135,134,136,137:GOTO 30;59:BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Omit semicolon in numeric definition');ERROR;END;
OTHERS:{148}BEGIN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Improper numeric definition will be flushed');ERROR;
END;REPEAT NEXTCONTROL:=SKIPAHEAD UNTIL(NEXTCONTROL>=132);
IF NEXTCONTROL=135 THEN BEGIN LOC:=LOC-2;NEXTCONTROL:=GETNEXT;END;
ACCUMULATOR:=0;GOTO 30;END END;END;30:;
IF ABS(ACCUMULATOR)>=32768 THEN BEGIN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Value too big: ',ACCUMULATOR:0);ERROR;END;
ACCUMULATOR:=0;END;EQUIV[P]:=ACCUMULATOR+32768;END;
{153}PROCEDURE SCANREPL(T:EIGHTBITS);LABEL 22,30,31;VAR A:SIXTEENBITS;
B:ASCIICODE;BAL:EIGHTBITS;BEGIN BAL:=0;
WHILE TRUE DO BEGIN 22:A:=GETNEXT;CASE A OF 40:BAL:=BAL+1;
41:IF BAL=0 THEN BEGIN WRITELN(TERMOUT);WRITE(TERMOUT,'! Extra )');
ERROR;END ELSE BAL:=BAL-1;39:{156}BEGIN B:=39;
WHILE TRUE DO BEGIN BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(
TERMOUT);WRITE(TERMOUT,'! Sorry, ','token',' capacity exceeded');ERROR;
QUIT;END;TOKMEM[Z,TOKPTR[Z]]:=B;TOKPTR[Z]:=TOKPTR[Z]+1;END;
IF B=64 THEN IF BUFFER[LOC]=64 THEN LOC:=LOC+1 ELSE BEGIN WRITELN(
TERMOUT);WRITE(TERMOUT,'! You should double @ signs in strings');ERROR;
END;IF LOC=LIMIT THEN BEGIN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! String didn''t end');ERROR;END;BUFFER[LOC]:=39;
BUFFER[LOC+1]:=0;END;B:=BUFFER[LOC];LOC:=LOC+1;
IF B=39 THEN BEGIN IF BUFFER[LOC]<>39 THEN GOTO 31 ELSE BEGIN LOC:=LOC+1
;BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Sorry, ','token',' capacity exceeded');ERROR;QUIT;END;
TOKMEM[Z,TOKPTR[Z]]:=39;TOKPTR[Z]:=TOKPTR[Z]+1;END;END;END;END;31:END;
35:IF T=3 THEN A:=13;{155}130:BEGIN A:=IDLOOKUP(0);
BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Sorry, ','token',' capacity exceeded');ERROR;QUIT;END;
TOKMEM[Z,TOKPTR[Z]]:=(A DIV 256)+128;TOKPTR[Z]:=TOKPTR[Z]+1;END;
A:=A MOD 256;END;
135:IF T<>135 THEN GOTO 30 ELSE BEGIN BEGIN IF TOKPTR[Z]=MAXTOKS THEN
BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Sorry, ','token',' capacity exceeded');ERROR;QUIT;END;
TOKMEM[Z,TOKPTR[Z]]:=(CURMODULE DIV 256)+168;TOKPTR[Z]:=TOKPTR[Z]+1;END;
A:=CURMODULE MOD 256;END;
133,132,134:IF T<>135 THEN GOTO 30 ELSE BEGIN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! @',XCHR[BUFFER[LOC-1]],' is ignored in PASCAL text');
ERROR;END;GOTO 22;END;136,137:GOTO 30;OTHERS:END;
BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Sorry, ','token',' capacity exceeded');ERROR;QUIT;END;
TOKMEM[Z,TOKPTR[Z]]:=A;TOKPTR[Z]:=TOKPTR[Z]+1;END;END;30:NEXTCONTROL:=A;
{154}IF BAL>0 THEN BEGIN IF BAL=1 THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Missing )');ERROR;END ELSE BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Missing ',BAL:0,' )''s');ERROR;END;
WHILE BAL>0 DO BEGIN BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(
TERMOUT);WRITE(TERMOUT,'! Sorry, ','token',' capacity exceeded');ERROR;
QUIT;END;TOKMEM[Z,TOKPTR[Z]]:=41;TOKPTR[Z]:=TOKPTR[Z]+1;END;BAL:=BAL-1;
END;END;IF TEXTPTR>MAXTEXTS-2 THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Sorry, ','text',' capacity exceeded');ERROR;QUIT;END;
CURREPLTEXT:=TEXTPTR;TOKSTART[TEXTPTR+2]:=TOKPTR[Z];TEXTPTR:=TEXTPTR+1;
IF Z=1 THEN Z:=0 ELSE Z:=Z+1;END;
{157}PROCEDURE DEFINEMACRO(T:EIGHTBITS);VAR P:NAMEPOINTER;
BEGIN P:=IDLOOKUP(T);SCANREPL(T);EQUIV[P]:=CURREPLTEXT;
TEXTLINK[CURREPLTEXT]:=0;END;{159}PROCEDURE SCANMODULE;LABEL 22,30,10;
VAR P:NAMEPOINTER;BEGIN MODULECOUNT:=MODULECOUNT+1;{160}NEXTCONTROL:=0;
WHILE TRUE DO BEGIN 22:WHILE NEXTCONTROL<=132 DO BEGIN NEXTCONTROL:=
SKIPAHEAD;IF NEXTCONTROL=135 THEN BEGIN LOC:=LOC-2;NEXTCONTROL:=GETNEXT;
END;END;IF NEXTCONTROL<>133 THEN GOTO 30;NEXTCONTROL:=GETNEXT;
IF NEXTCONTROL<>130 THEN BEGIN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Definition flushed, must start with ',
'identifier of length > 1');ERROR;END;GOTO 22;END;NEXTCONTROL:=GETNEXT;
IF NEXTCONTROL=61 THEN BEGIN SCANNUMERIC(IDLOOKUP(1));GOTO 22;
END ELSE IF NEXTCONTROL=30 THEN BEGIN DEFINEMACRO(2);GOTO 22;
END ELSE{161}IF NEXTCONTROL=40 THEN BEGIN NEXTCONTROL:=GETNEXT;
IF NEXTCONTROL=35 THEN BEGIN NEXTCONTROL:=GETNEXT;
IF NEXTCONTROL=41 THEN BEGIN NEXTCONTROL:=GETNEXT;
IF NEXTCONTROL=61 THEN BEGIN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Use == for macros');ERROR;END;NEXTCONTROL:=30;END;
IF NEXTCONTROL=30 THEN BEGIN DEFINEMACRO(3);GOTO 22;END;END;END;END;;
BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Definition flushed since it starts badly');ERROR;END;
END;30:;{162}CASE NEXTCONTROL OF 134:P:=0;135:BEGIN P:=CURMODULE;
{163}REPEAT NEXTCONTROL:=GETNEXT;UNTIL NEXTCONTROL<>43;
IF(NEXTCONTROL<>61)AND(NEXTCONTROL<>30)THEN BEGIN BEGIN WRITELN(TERMOUT)
;WRITE(TERMOUT,'! PASCAL text flushed, = sign is missing');ERROR;END;
REPEAT NEXTCONTROL:=SKIPAHEAD;UNTIL NEXTCONTROL>=136;GOTO 10;END;END;
OTHERS:GOTO 10 END;{164}STORETWOBYTE(53248+MODULECOUNT);;SCANREPL(135);
{165}IF P=0 THEN BEGIN TEXTLINK[LASTUNNAMED]:=CURREPLTEXT;
LASTUNNAMED:=CURREPLTEXT;
END ELSE IF EQUIV[P]=0 THEN EQUIV[P]:=CURREPLTEXT ELSE BEGIN P:=EQUIV[P]
;WHILE TEXTLINK[P]<MAXTEXTS DO P:=TEXTLINK[P];TEXTLINK[P]:=CURREPLTEXT;
END;TEXTLINK[CURREPLTEXT]:=MAXTEXTS;;;10:END;{168}{PROCEDURE DEBUGHELP;
LABEL 889,888,10;VAR K:SIXTEENBITS;BEGIN DEBUGSKIPPED:=DEBUGSKIPPED+1;
IF DEBUGSKIPPED<DEBUGCYCLE THEN GOTO 10;DEBUGSKIPPED:=0;GOTO 889;
888:['*************breakpoint*************';
'***********for**debugging***********'];
889:WHILE TRUE DO BEGIN WRITE(TERMOUT,'#');BREAK(TERMOUT);
READ(TERMIN,DDT);IF DDT<0 THEN GOTO 10 ELSE IF DDT=0 THEN GOTO 888;
READ(TERMIN,DD);CASE DDT OF 1:PRINTID(DD);2:PRINTREPL(DD);
3:FOR K:=1 TO DD DO WRITE(TERMOUT,XCHR[BUFFER[K]]);
4:FOR K:=1 TO DD DO WRITE(TERMOUT,XCHR[MODTEXT[K]]);
5:FOR K:=1 TO OUTPTR DO WRITE(TERMOUT,XCHR[OUTBUF[K]]);
6:FOR K:=1 TO DD DO WRITE(TERMOUT,XCHR[OUTCONTRIB[K]]);
OTHERS:WRITE(TERMOUT,'?')END;END;10:END;}{169}BEGIN INITIALIZE;
{122}OPENINPUT;LINE:=1;CHANGING:=FALSE;PRIMETHECHAN;OTHERLINE:=LINE;
LINE:=0;LIMIT:=0;LOC:=1;BUFFER[0]:=32;INPUTHASENDE:=FALSE;;
WRITELN(TERMOUT,'This is TANGLE, Version 0.9');{170}PHASEONE:=TRUE;
MODULECOUNT:=0;REPEAT NEXTCONTROL:=SKIPAHEAD;
WHILE NEXTCONTROL=137 DO SCANMODULE;UNTIL INPUTHASENDE;PHASEONE:=FALSE;;
FOR ZO:=0 TO 1 DO MAXTOKPTR[ZO]:=TOKPTR[ZO];
{108}IF TEXTLINK[0]=0 THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! No output was specified.');
END ELSE BEGIN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'Writing the output file');END;{79}STACKPTR:=1;
BRACELEVEL:=0;CURSTATE.NAMEFIELD:=0;CURSTATE.REPLFIELD:=TEXTLINK[0];
ZO:=CURSTATE.REPLFIELD MOD 2;
CURSTATE.BYTEFIELD:=TOKSTART[CURSTATE.REPLFIELD];
CURSTATE.ENDFIELD:=TOKSTART[CURSTATE.REPLFIELD+2];;{92}OUTSTATE:=0;
OUTPTR:=0;BREAKPTR:=0;SEMIPTR:=0;OUTBUF[0]:=0;LINE:=1;;SENDTHEOUTPU;
{94}IF(OUTSTATE<>0)OR(OUTBUF[BREAKPTR]<>46)THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Program didn''t end with period');ERROR;END;
BREAKPTR:=OUTPTR;SEMIPTR:=0;FLUSHBUFFER;;BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'Done.');END;END;
{129}IF CHANGELIMIT<>0 THEN BEGIN FOR LOC:=0 TO CHANGELIMIT DO BUFFER[
LOC]:=CHANGEBUFFER[LOC];LIMIT:=CHANGELIMIT;CHANGING:=TRUE;
LINE:=OTHERLINE;PHASEONE:=TRUE;BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'! Change file entry did not match');ERROR;END;END;
9999:IF STRINGPTR>128 THEN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,STRINGPTR-128:0,' strings written to string pool file.');
END;{171}BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'Memory usage statistics:');END;BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,NAMEPTR:0,' names, ',TEXTPTR:0,' replacement texts;');END;
BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,BYTEPTR:0,' bytes, ',MAXTOKPTR[0]:0);END;
FOR ZO:=1 TO 1 DO WRITE(TERMOUT,'+',MAXTOKPTR[ZO]:0);
WRITE(TERMOUT,' tokens.');;END.